home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0068_XOR Encryption Code.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  8.8 KB  |  238 lines
  1. {
  2. Here you have an encriptation program based in Xor encription by
  3. bits manipulation
  4.  
  5. XOR        1101  1001   the origin file
  6.            0101  0011   Password      Encription
  7.          _____________                ^^
  8.            1000  1010
  9.  
  10.  
  11. XOR        1000  1010   the destination file
  12.            0101  0011   Password       decryption
  13.         --------------                 ^^
  14.            1101  1001
  15.  
  16.  
  17. I recommend you to read the book "Advanced Turbo Pascal: Programming and
  18. Techniques"  of Herbert Schildt (1987)
  19. (The book i read)
  20. }
  21.  
  22.  
  23.       PROGRAM Clave;
  24.       {    Por: JAVIER PEREZ-VIGO FDEZ  6/01/1994          }
  25.       {    Codifica y descodifica ficheros mediante un XOR }
  26.       USES CRT;
  27.       VAR
  28.          Fuente,Destino:     FILE;
  29.          Ma,Mo:              CHAR;
  30.          Buffer:             ARRAY[1..2048] of byte;
  31.          Leidos,f,a,b,c,d,Largo1,Largo2,Largo3:   INTEGER;
  32.          ch:char;
  33.          Par1,Par2,Par3:     STRING;
  34.  
  35.       FUNCTION EXISTE_ARCH(Nombre:STRING):BOOLEAN;
  36.          VAR
  37.            F:FILE;
  38.            OK:BOOLEAN;
  39.          BEGIN            { Existe_Arch }
  40.            Assign (f,Nombre);
  41.            {$I-}                              {Exists file?}
  42.            Reset(f);
  43.            {$I+}
  44.            OK:=IOresult=0;
  45.            If Not OK then
  46.               Existe_Arch:=False
  47.             else
  48.               begin
  49.                 close(f);
  50.                 existe_Arch:=True;
  51.               end;        { else }
  52.          END;             { Existe_Arch }
  53.  
  54.       PROCEDURE MENU;
  55.         BEGIN             { Menu }
  56.          Clrscr;
  57.          TextColor(white);
  58.          GotoXY( 1, 1);Write('╔══════════════════════════════════════════════════════════════════════════════╗');
  59.          GotoXY( 1, 2);Write('║       ╔═════════════════════════════════════════════════════════════════╗    ║');
  60.          GotoXY( 1, 3);Write('║       ║           UTILIDAD DE ENCRIPACION / DESENCRIPTACION             ║    ║');
  61.          GotoXY( 1, 4);Write('║       ║ Por: Javier Pérez-Vigo 1993                                     ║    ║');
  62.          GotoXY( 1, 5);Write('║       ╚═════════════════════════════════════════════════════════════════╝    ║');
  63.          GotoXY( 1, 6);Write('║                                                                              ║');
  64.          GotoXY( 1, 7);Write('║       ╔═════════════════════════════════════════════════════════════════╗    ║');
  65.          GotoXY( 1, 8);Write('║       ║ ∙Nombre del archivo a des/encriptar :                           ║    ║');
  66.                                   {Name of the file to de/encript}
  67.  
  68.          GotoXY(60,8);TextColor(red);Write('? ');
  69.          GotoXY(60,8);TextColor(red);Write(Paramstr(1));
  70.          TextColor(white);
  71.          GotoXY( 1, 9);Write('║       ║                                                                 ║    ║');
  72.          GotoXY( 1,10);Write('║       ║ ∙Nombre del archivo des/encriptado  :                           ║    ║');
  73.  
  74.                                   {Name of the to de/encripted file}
  75.  
  76.          GotoXY(60,10);TextColor(red);Write('? ');
  77.          GotoXY(60,10);TextColor(red);Write(paramstr(2));
  78.          TextColor(white);
  79.          GotoXY( 1,11);Write('║       ║                                                                 ║    ║');
  80.          GotoXY( 1,12);Write('║       ║ ∙Clave de encriptación:                                         ║    ║');
  81.                                     {Password}
  82.  
  83.          GotoXY(60,12);TextColor(red);Write('? ');
  84.          GotoXY(60,12);TextColor(red);Write(paramstr(3));
  85.          TextColor(white);
  86.          GotoXY( 1,13);Write('║       ║                                                                 ║    ║');
  87.          GotoXY( 1,14);Write('║       ╠═════════════════════════════════════════════════════════════════╣    ║');
  88.          GotoXY( 1,15);Write('║       ║                                                                 ║    ║');
  89.          GotoXY( 1,16);Write('║       ╚═════════════════════════════════════════════════════════════════╝    ║');
  90.          GotoXY( 1,17);Write('║                                                                              ║');
  91.          GotoXY( 1,18);Write('║                                                                              ║');
  92.          GotoXY( 1,19);Write('║                                                                              ║');
  93.          GotoXY( 1,20);Write('║                                                                              ║');
  94.          GotoXY( 1,21);Write('║                                                                              ║');
  95.          GotoXY( 1,22);Write('╚══════════════════════════════════════════════════════════════════════════════╝');
  96. END;
  97.      PROCEDURE FIN;
  98.        BEGIN
  99.          MENU;
  100.          TextColor(YELLOW);           {Clave [origin] [destination] [password number] }
  101.          GotoXY( 6,17);
  102.          WriteLn ('                    Clave  [origen]    [destino]   [nº clave]');
  103.          TextColor(RED);
  104.          GotoXY( 6,18);
  105.          WriteLn('=======================================');
  106.          TextColor(YELLOW);
  107.          GotoXY( 6,19);
  108.          WriteLn ('     ENCRIPTAR:     Clave  texto.doc   secret.doc  12345');
  109.          GotoXY( 6,20);
  110.          WriteLn ('     DESENCRIPTAR:  Clave  secret.doc  texto.txt   12345');
  111.        END;
  112.  
  113.  
  114.     BEGIN  { Programa Principal }   {Main}
  115.         Clrscr;
  116.         Largo1:=LENGTH(Paramstr(1));
  117.         Largo2:=LENGTH(Paramstr(2));
  118.         Largo3:=LENGTH(Paramstr(3));
  119.         If (Largo1 =0) OR (Largo2=0) OR (Largo3=0) then
  120.            Begin
  121.              Clrscr;
  122.              FIN;
  123.              Par1:='';Par2:='';Par3:='';
  124.              if largo1=0 then Par1:=' ORIGEN,';
  125.              if largo2=0 then Par2:=' DESTINO,';
  126.              if largo3=0 then Par3:=' CLAVE';
  127.              GotoXY(10,15);
  128.              TextColor(red);
  129.              Write(' ¡ Introduzca los parámetros ¡ :   ',PAR1,PAR2,PAR3);
  130.  
  131.                                         {introduce the parameters}
  132.  
  133.              TextColor(WHITE);
  134.              GotoXY(1,24);
  135.              Halt(0);
  136.            End;
  137.         If Paramstr(1)=Paramstr(2) Then
  138.            begin;
  139.               Fin;
  140.               GotoXY(10,15);
  141.               TextColor(RED);
  142.               Write(' ¡ Introduzca distintos ficheros ORIGEN y DESTINO ! ');
  143.               TextColor(WHITE);
  144.  
  145.                {origin and destination are the same file}
  146.  
  147.               GotoXY(1,24);
  148.               Halt(1);
  149.            end;
  150.  
  151.        ASSIGN (FUENTE,PARAMSTR(1));
  152.        if existe_arch (paramstr(1)) then
  153.          RESET (FUENTE,1)
  154.        else
  155.          BEGIN
  156.            Clrscr;
  157.            FIN;
  158.            GotoXY(10,15);
  159.            TextColor(RED);
  160.            Write(' ¡ No existe el fichero ORIGEN ! ');
  161.  
  162.            {The origin file don't exist}
  163.  
  164.            TextColor(WHITE);
  165.            GotoXY(1,24);
  166.            Halt(2);
  167.          END;
  168.        ASSIGN (DESTINO,PARAMSTR(2));
  169.        if existe_arch (paramstr(2)) then
  170.            BEGIN
  171.              Clrscr;
  172.              MENU;
  173.              GotoXY(9,18);
  174.              TextColor(LightGreen);
  175.              Write('El archivo destino  < ');
  176.              TextColor(LightRed);
  177.  
  178.              {if destination file exist}
  179.  
  180.              Write(PARAMSTR(2));
  181.              TextColor(LightGreen);
  182.              Write(' > existe');
  183.              GotoXY(9,20);
  184.              Write('¿ Quiere SOBREESCRIBIRLO ? ');
  185.  
  186.              {rewrite it?}
  187.  
  188.              TextColor(LightRed);
  189.              write(' (S/N) ');
  190.              TextColor(White);
  191.              Ch := ReadKey;
  192.              TextColor(White);
  193.              if Upcase(Ch) <> 'S'  then
  194.                begin
  195.                  Close(fuente);
  196.                  Clrscr;
  197.                  FIN;
  198.                  GotoXY(10,15);
  199.                  TextColor(Red);
  200.                  Write(' ¡ Escriba un nuevo nombre de fichero DESTINO !');
  201.                  TextColor(White);
  202.  
  203.                  {write a new name for destination file}
  204.  
  205.                  GotoXY(1,24);
  206.                  Halt(3);
  207.                end;
  208.           END;
  209.  
  210.         ReWrite(DESTINO,1);
  211.         VAL(Paramstr(3),RANDSEED,F);
  212.         Clrscr;
  213.         MENU;
  214.         GotoXY(10,15);
  215.         TextColor(Blue);
  216.         Write('==>');
  217.         a:=1;
  218.         TextColor(Red);
  219.         REPEAT
  220.           BlockRead(FUENTE,BUFFER,SIZEOF(BUFFER),LEIDOS);
  221.           FOR F:=1 TO LEIDOS DO
  222.              Buffer[F] := Buffer[F] XOR RANDOM(255);
  223.              TextColor((a div 60)+1);
  224.              Write('▐');
  225.              a:=a+1;
  226.              if  (a mod 60 =0)  then GotoXY(13,15);
  227.           BlockWrite(DESTINO,BUFFER,LEIDOS);
  228.         UNTIL (LEIDOS=0);
  229.         CLOSE (FUENTE);
  230.         CLOSE (DESTINO);
  231.         TextColor(White);
  232.         WriteLn;
  233.         WriteLn;
  234.         WriteLn;
  235.         GotoXY(1,24);
  236.         Halt(4)
  237.       END.
  238.